home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 039a / mawk.zip / PARSE.Y < prev    next >
Text File  |  1991-04-17  |  30KB  |  1,077 lines

  1.  
  2. /********************************************
  3. parse.y
  4. copyright 1991, Michael D. Brennan
  5.  
  6. This is a source file for mawk, an implementation of
  7. the Awk programming language as defined in
  8. Aho, Kernighan and Weinberger, The AWK Programming Language,
  9. Addison-Wesley, 1988.
  10.  
  11. See the accompaning file, LIMITATIONS, for restrictions
  12. regarding modification and redistribution of this
  13. program in source or binary form.
  14. ********************************************/
  15.  
  16. /* $Log:    parse.y,v $
  17.  * Revision 2.1  91/04/08  08:23:39  brennan
  18.  * VERSION 0.97
  19.  * 
  20. */
  21.  
  22.  
  23. %{
  24. #include <stdio.h>
  25. #include "mawk.h"
  26. #include "code.h"
  27. #include "symtype.h"
  28. #include "memory.h"
  29. #include "bi_funct.h"
  30. #include "bi_vars.h"
  31. #include "jmp.h"
  32. #include "field.h"
  33. #include "files.h"
  34.  
  35. extern void  PROTO( eat_nl, (void) ) ;
  36. static void  PROTO( resize_fblock, (FBLOCK *, INST *) ) ;
  37. static void  PROTO( code_array, (SYMTAB *) ) ;
  38. static void  PROTO( code_call_id, (CA_REC *, SYMTAB *) ) ;
  39. static int   PROTO( current_offset, (void) ) ;
  40.  
  41. static int scope ;
  42. static FBLOCK *active_funct ;
  43.       /* when scope is SCOPE_FUNCT  */
  44.  
  45. #define  code_address(x)  if( is_local(x) )\
  46.                           { code1(L_PUSHA) ; code1((x)->offset) ; }\
  47.                           else  code2(_PUSHA, (x)->stval.cp) 
  48.  
  49. %}
  50.  
  51. %union{
  52. CELL *cp ;
  53. SYMTAB *stp ;
  54. INST  *start ; /* code starting address */
  55. PF_CP  fp ;  /* ptr to a (print/printf) or (sub/gsub) function */
  56. BI_REC *bip ; /* ptr to info about a builtin */
  57. FBLOCK  *fbp  ; /* ptr to a function block */
  58. ARG2_REC *arg2p ;
  59. CA_REC   *ca_p  ;
  60. int   ival ;
  61. }
  62.  
  63. /*  two tokens to help with errors */
  64. %token   UNEXPECTED   /* unexpected character */
  65. %token   BAD_DECIMAL
  66.  
  67. %token   NL
  68. %token   SEMI_COLON
  69. %token   LBRACE  RBRACE
  70. %token   LBOX     RBOX
  71. %token   COMMA
  72. %token   <ival> IO_OUT    /* > or output pipe */
  73.  
  74. %left   P_OR
  75. %left   P_AND
  76. %right  ASSIGN  ADD_ASG SUB_ASG MUL_ASG DIV_ASG MOD_ASG POW_ASG
  77. %right  QMARK COLON
  78. %left   OR
  79. %left   AND
  80. %left   IN
  81. %left   MATCH  NOT_MATCH
  82. %left   EQ  NEQ  LT LTE  GT  GTE
  83. %left   CAT
  84. %left   GETLINE
  85. %left   PLUS      MINUS  
  86. %left   MUL      DIV    MOD
  87. %left   NOT   UMINUS
  88. %nonassoc   IO_IN PIPE
  89. %right  POW
  90. %left   INC  DEC   /* ++ -- */
  91. %left   DOLLAR    ID  FIELD  /* last two to remove a SR conflict
  92.                                 with getline */
  93. %right  LPAREN   RPAREN     /* removes some SR conflicts */
  94. %token  <cp>  CONSTANT  RE
  95. %token  <stp> ID   
  96. %token  <fbp> FUNCT_ID
  97. %token  <bip> BUILTIN 
  98. %token   <cp>  FIELD 
  99.  
  100. %token  PRINT PRINTF SPLIT MATCH_FUNC SUB GSUB LENGTH
  101. /* keywords */
  102. %token  DO WHILE FOR BREAK CONTINUE IF ELSE  IN
  103. %token  DELETE  BEGIN  END  EXIT NEXT RETURN  FUNCTION
  104.  
  105. %type <start>  block  block_or_newline
  106. %type <start>  statement_list statement mark
  107. %type <start>  pattern  p_pattern
  108. %type <start>  print_statement
  109. %type <ival>   pr_args
  110. %type <arg2p>  arg2  
  111. %type <start>  builtin  
  112. %type <start>  getline_file
  113. %type <start>  lvalue field  fvalue
  114. %type <start>  expr cat_expr p_expr  re_or_expr  sub_back
  115. %type <start>  do_statement  while_statement  for_statement
  116. %type <start>  if_statement if_else_statement
  117. %type <start>  while_front  if_front  for_front
  118. %type <start>  fexpr0 fexpr1
  119. %type <start>  array_loop  array_loop_front
  120. %type <start>  exit_statement  return_statement
  121. %type <ival>   arglist args 
  122. %type <stp>     id  array
  123. %type <fp>     print   sub_or_gsub
  124. %type <fbp>    funct_start funct_head
  125. %type <ca_p>   call_args ca_front ca_back
  126. %type <ival>   f_arglist f_args
  127.  
  128. %%
  129. /*  productions  */
  130.  
  131. program :       program_block
  132.         |       program  program_block 
  133.         ;
  134.  
  135. program_block :  PA_block
  136.               |  function_def
  137.               |  error block
  138.                  { if (scope == SCOPE_FUNCT)
  139.                    { restore_ids() ; scope = SCOPE_MAIN ; }
  140.                    code_ptr = main_code_ptr ;
  141.                  }
  142.               ;
  143.  
  144. PA_block  :  block
  145.  
  146.           |  BEGIN  
  147.                 { main_code_ptr = code_ptr ;
  148.                   code_ptr = begin_code_ptr ; 
  149.                   scope = SCOPE_BEGIN ;
  150.                 }
  151.  
  152.              block
  153.                 { begin_code_ptr = code_ptr ;
  154.                   code_ptr = main_code_ptr ; 
  155.                   scope = SCOPE_MAIN ;
  156.                 }
  157.  
  158.           |  END    
  159.                 { main_code_ptr = code_ptr ;
  160.                   code_ptr = end_code_ptr ; 
  161.                   scope = SCOPE_END ;
  162.                 }
  163.  
  164.              block
  165.                 { end_code_ptr = code_ptr ;
  166.                   code_ptr = main_code_ptr ; 
  167.                   scope = SCOPE_MAIN ;
  168.                 }
  169.  
  170.           |  pattern  /* this works just like an if statement */
  171.              { code_jmp(_JZ, 0) ; }
  172.  
  173.              block_or_newline
  174.              { patch_jmp( code_ptr ) ; }
  175.  
  176.     /* range pattern, see comment in execute.c near _RANGE */
  177.           |  pattern COMMA 
  178.              { code_push($1, code_ptr - $1) ;
  179.                code_ptr = $1 ;
  180.                code1(_RANGE) ; code1(1) ;
  181.                code_ptr += 3 ;
  182.                code_ptr += code_pop(code_ptr) ;
  183.                code1(_STOP0) ;
  184.                $1[2].op = code_ptr - ($1+1) ;
  185.              }
  186.              pattern
  187.              { code1(_STOP0) ; }
  188.  
  189.              block_or_newline
  190.              { $1[3].op = $6 - ($1+1) ;
  191.                $1[4].op = code_ptr - ($1+1) ;
  192.              }
  193.           ;
  194.  
  195. pattern :  expr       %prec  LPAREN
  196.         |  p_pattern
  197.  
  198. /*  these work just like short circuit booleans */
  199.         |  pattern P_OR  
  200.                 { code1(_DUP) ;
  201.                   code_jmp(_JNZ, 0) ;
  202.                   code1(_POP) ;
  203.                 }
  204.                 pattern
  205.                 { patch_jmp(code_ptr) ; }
  206.  
  207.         |  pattern P_AND
  208.                 { code1(_DUP) ;
  209.                   code_jmp(_JZ, 0) ;
  210.                   code1(_POP) ;
  211.                 }
  212.                 pattern
  213.                 { patch_jmp(code_ptr) ; }
  214.         ;
  215.  
  216. /* we want the not (!) operator to apply to expr if possible
  217.    and then to a pattern.  Two types of pattern do it */
  218.  
  219. p_pattern  :  RE
  220.               { $$ = code_ptr ;
  221.                 code2(_PUSHI, &field[0]) ;
  222.                 code2(_PUSHC, $1) ;
  223.                 code1(_MATCH) ;
  224.               }
  225.  
  226.            |  LPAREN  pattern RPAREN
  227.               { $$ = $2 ; }
  228.            |  NOT  p_pattern
  229.               { code1(_NOT) ; $$ = $2 ; }
  230.            ;
  231.  
  232.  
  233. block   :  LBRACE   statement_list  RBRACE
  234.             { $$ = $2 ; }
  235.         |  LBRACE   error  RBRACE 
  236.             { $$ = code_ptr ; /* does nothing won't be executed */
  237.               print_flag = getline_flag = paren_cnt = 0 ;
  238.               yyerrok ; }
  239.         ;
  240.  
  241. block_or_newline  :  block
  242.                   |  NL     /* default print action */
  243.                      { $$ = code_ptr ;
  244.                        code1(_PUSHINT) ; code1(0) ;
  245.                        code2(_PRINT, bi_print) ;
  246.                      }
  247.  
  248. statement_list :  statement
  249.         |  statement_list   statement
  250.         ;
  251.  
  252.  
  253. statement :  block
  254.           |  expr   separator
  255.              { code1(_POP) ; }
  256.           |  /* empty */  separator
  257.              { $$ = code_ptr ; }
  258.           |  error  separator
  259.               { $$ = code_ptr ;
  260.                 print_flag = getline_flag = 0 ;
  261.                 paren_cnt = 0 ;
  262.                 yyerrok ;
  263.               }
  264.           |  print_statement
  265.           |  if_statement
  266.           |  if_else_statement
  267.           |  do_statement
  268.           |  while_statement
  269.           |  for_statement
  270.           |  array_loop
  271.           |  BREAK  separator
  272.              { $$ = code_ptr ; BC_insert('B', code_ptr) ;
  273.                code2(_JMP, 0) /* don't use code_jmp ! */ ; }
  274.           |  CONTINUE  separator
  275.              { $$ = code_ptr ; BC_insert('C', code_ptr) ;
  276.                code2(_JMP, 0) ; }
  277.           |  exit_statement
  278.           |  return_statement
  279.              { if ( scope != SCOPE_FUNCT )
  280.                      compile_error("return outside function body") ;
  281.              }
  282.           |  NEXT  separator
  283.               { if ( scope != SCOPE_MAIN )
  284.                    compile_error( "improper use of next" ) ;
  285.                 $$ = code_ptr ; code1(_NEXT) ;
  286.               }
  287.           ;
  288.  
  289. separator  :  NL | SEMI_COLON
  290.            ;
  291.  
  292. expr  :   cat_expr
  293.       |   lvalue   ASSIGN   expr { code1(_ASSIGN) ; }
  294.       |   lvalue   ADD_ASG  expr { code1(_ADD_ASG) ; }
  295.       |   lvalue   SUB_ASG  expr { code1(_SUB_ASG) ; }
  296.       |   lvalue   MUL_ASG  expr { code1(_MUL_ASG) ; }
  297.       |   lvalue   DIV_ASG  expr { code1(_DIV_ASG) ; }
  298.       |   lvalue   MOD_ASG  expr { code1(_MOD_ASG) ; }
  299.       |   lvalue   POW_ASG  expr { code1(_POW_ASG) ; }
  300.       |   expr EQ expr  { code1(_EQ) ; }
  301.       |   expr NEQ expr { code1(_NEQ) ; }
  302.       |   expr LT expr { code1(_LT) ; }
  303.       |   expr LTE expr { code1(_LTE) ; }
  304.       |   expr GT expr { code1(_GT) ; }
  305.       |   expr GTE expr { code1(_GTE) ; }
  306.       |   expr MATCH re_or_expr
  307.           { code1(_MATCH) ; }
  308.       |   expr NOT_MATCH  re_or_expr
  309.           { code1(_MATCH) ; code1(_NOT) ; }
  310.  
  311. /* short circuit boolean evaluation */
  312.       |   expr  OR
  313.               { code1(_DUP) ;
  314.                 code_jmp(_JNZ, 0) ;
  315.                 code1(_POP) ;
  316.               }
  317.           expr
  318.           { patch_jmp(code_ptr) ; code1(_TEST) ; }
  319.  
  320.       |   expr AND
  321.               { code1(_DUP) ; code_jmp(_JZ, 0) ;
  322.                 code1(_POP) ; }
  323.           expr
  324.               { patch_jmp(code_ptr) ; code1(_TEST) ; }
  325.  
  326.       |  expr QMARK  { code_jmp(_JZ, 0) ; }
  327.          expr COLON  { code_jmp(_JMP, 0) ; }
  328.          expr
  329.          { patch_jmp(code_ptr) ; patch_jmp($7) ; }
  330.       ;
  331.  
  332. cat_expr :  p_expr             %prec CAT
  333.          |  cat_expr  p_expr   %prec CAT 
  334.             { code1(_CAT) ; }
  335.          ;
  336.  
  337. p_expr  :   CONSTANT
  338.           {  $$ = code_ptr ; code2(_PUSHC, $1) ; }
  339.       |   lvalue  %prec CAT /* removes lvalue (++|--) sr conflict */
  340.             { switch( code_ptr[-2].op )
  341.               { case _PUSHA :
  342.                       code_ptr[-2].op = _PUSHI ;
  343.                       break ;
  344.                 case AE_PUSHA :
  345.                       code_ptr[-2].op = AE_PUSHI ;
  346.                       break ;
  347.                 case L_PUSHA :
  348.                       code_ptr[-2].op = L_PUSHI ;
  349.                       break ;
  350.                 case LAE_PUSHA :
  351.                       code_ptr[-2].op = LAE_PUSHI ;
  352.                       break ;
  353. #ifdef  DEBUG
  354.                 default : bozo("p_expr->lvalue") ;
  355. #endif
  356.               }
  357.             }
  358.       |   LPAREN   expr  RPAREN
  359.           { $$ = $2 ; }
  360.       ;
  361. p_expr  :   p_expr  PLUS   p_expr { code1(_ADD) ; } 
  362.       |   p_expr MINUS  p_expr { code1(_SUB) ; }
  363.       |   p_expr  MUL   p_expr { code1(_MUL) ; }
  364.       |   p_expr  DIV  p_expr { code1(_DIV) ; }
  365.       |   p_expr  MOD  p_expr { code1(_MOD) ; }
  366.       |   p_expr  POW  p_expr { code1(_POW) ; }
  367.       |   NOT  p_expr  
  368.                 { $$ = $2 ; code1(_NOT) ; }
  369.       |   PLUS p_expr  %prec  UMINUS
  370.                 { $$ = $2 ; code1(_UPLUS) ; }
  371.       |   MINUS p_expr %prec  UMINUS
  372.                 { $$ = $2 ; code1(_UMINUS) ; }
  373.       |   builtin
  374.       ;
  375.  
  376. p_expr  :  lvalue  INC   
  377.         { code1(_POST_INC ) ; }
  378.         |  lvalue  DEC  
  379.         { code1(_POST_DEC) ; }
  380.         |  INC  lvalue
  381.         { $$ = $2 ; code1(_PRE_INC) ; }
  382.         |  DEC  lvalue
  383.         { $$ = $2 ; code1(_PRE_DEC) ; }
  384.         ;
  385.  
  386. p_expr  :  field  INC   
  387.         { code1(F_POST_INC ) ; }
  388.         |  field  DEC  
  389.         { code1(F_POST_DEC) ; }
  390.         |  INC  field
  391.         { $$ = $2 ; code1(F_PRE_INC) ; }
  392.         |  DEC  field
  393.         { $$ = $2 ; code1(F_PRE_DEC) ; }
  394.         ;
  395.  
  396. lvalue :  id     
  397.         { $$ = code_ptr ; code_address($1) ; }
  398.        |  LPAREN  lvalue RPAREN
  399.           { $$ = $2 ; }
  400.        ;
  401.  
  402. id      :   ID  
  403.             {
  404.               switch($1->type)
  405.               {
  406.                 case ST_NONE : /* new id */
  407.                     $1->type = ST_VAR ;
  408.                     $1->stval.cp = new_CELL() ;
  409.                     $1->stval.cp->type = C_NOINIT ;
  410.                     break ;
  411.  
  412.                 case ST_LOCAL_NONE :
  413.                     $1->type = ST_LOCAL_VAR ;
  414.                     active_funct->typev[$1->offset] = ST_LOCAL_VAR ;
  415.                     break ;
  416.  
  417.                 case ST_VAR :
  418.                 case ST_LOCAL_VAR :  break ;
  419.  
  420.                 default :
  421.                     type_error($1) ;
  422.                     break ;
  423.               }
  424.            }
  425.         ;
  426.  
  427. arglist :  /* empty */
  428.             { $$ = 0 ; }
  429.         |  args
  430.         ;
  431.  
  432. args    :  expr        %prec  LPAREN
  433.             { $$ = 1 ; }
  434.         |  args  COMMA  expr
  435.             { $$ = $1 + 1 ; }
  436.         ;
  437.  
  438. builtin :
  439.         BUILTIN mark  LPAREN  arglist RPAREN
  440.         { BI_REC *p = $1 ;
  441.           $$ = $2 ;
  442.           if ( p-> min_args > $4 || p->max_args < $4 )
  443.             compile_error(
  444.             "wrong number of arguments in call to %s" ,
  445.             p->name ) ;
  446.           if ( p->min_args != p->max_args ) /* variable args */
  447.                code2(_PUSHINT , $4 ) ;
  448.           code2(_BUILTIN , p->fp) ;
  449.         }
  450.         ;
  451.  
  452. /* an empty production to store the code_ptr */
  453. mark : /* empty */
  454.          { $$ = code_ptr ; }
  455.  
  456. print_statement : print mark pr_args pr_direction separator
  457.             { code2(_PRINT, $1) ; $$ = $2 ;
  458.               if ( $1 == bi_printf && $3 == 0 )
  459.                     compile_error("no arguments in call to printf") ;
  460.               print_flag = 0 ;
  461.               $$ = $2 ;
  462.             }
  463.             ;
  464.  
  465. print   :  PRINT  { $$ = bi_print ; print_flag = 1 ;}
  466.         |  PRINTF { $$ = bi_printf ; print_flag = 1 ; }
  467.         ;
  468.  
  469. pr_args :  arglist { code1(_PUSHINT) ; code1($1) ; }
  470.         |  LPAREN  arg2 RPAREN
  471.            { $$ = $2->cnt ; zfree($2,sizeof(ARG2_REC)) ; 
  472.              code1(_PUSHINT) ; code1($$) ; 
  473.            }
  474.         ;
  475.  
  476. arg2   :   expr  COMMA  expr
  477.            { $$ = (ARG2_REC*) zmalloc(sizeof(ARG2_REC)) ;
  478.              $$->start = $1 ;
  479.              $$->cnt = 2 ;
  480.            }
  481.         |   arg2 COMMA  expr
  482.             { $$ = $1 ; $$->cnt++ ; }
  483.         ;
  484.  
  485. pr_direction : /* empty */
  486.              |  IO_OUT  expr
  487.                 { code2(_PUSHINT, $1) ; }
  488.              ;
  489.  
  490.  
  491. /*  IF and IF-ELSE */
  492.  
  493. if_front :  IF LPAREN expr RPAREN
  494.             {  $$ = $3 ; eat_nl() ; code_jmp(_JZ, 0) ; }
  495.          ;
  496.  
  497. if_statement : if_front statement
  498.                 { patch_jmp( code_ptr ) ;  }
  499.               ;
  500.  
  501. else    :  ELSE { eat_nl() ; code_jmp(_JMP, 0) ; }
  502.         ;
  503.  
  504. if_else_statement :  if_front statement else statement
  505.                 { patch_jmp(code_ptr) ; patch_jmp($4) ; }
  506.  
  507.  
  508. /*  LOOPS   */
  509.  
  510. do      :  DO
  511.         { eat_nl() ; BC_new() ; }
  512.         ;
  513.  
  514. do_statement : do statement WHILE LPAREN expr RPAREN separator
  515.         { $$ = $2 ;
  516.           code_jmp(_JNZ, $2) ; 
  517.           BC_clear(code_ptr, $5) ; }
  518.         ;
  519.  
  520. while_front :  WHILE LPAREN expr RPAREN
  521.                 { eat_nl() ; BC_new() ;
  522.                   code_push($3, code_ptr-$3) ;
  523.                   code_ptr = $$ = $3 ;
  524.                   code_jmp(_JMP,0) ;
  525.                 }
  526.             ;
  527.  
  528. while_statement :  while_front  statement
  529.                 { INST *c_addr = code_ptr ; /*continue address*/
  530.  
  531.                   patch_jmp( c_addr) ;
  532.                   code_ptr += code_pop(c_addr) ;
  533.                   code_jmp(_JNZ, $2) ;
  534.                   BC_clear(code_ptr, c_addr) ;
  535.                 }
  536.                 ;
  537.  
  538. for_front  :  FOR LPAREN fexpr0 SEMI_COLON 
  539.                          fexpr1 SEMI_COLON  fexpr0 RPAREN
  540.  
  541.               { $$ = $3 ; eat_nl() ; BC_new() ;
  542.                 /* push fexpr2 and 3 */
  543.                 code_push( $5, $7-$5) ;
  544.                 code_push( $7, code_ptr - $7) ;
  545.                 /* reset code_ptr */
  546.                 code_ptr = $5 ;
  547.                 code_jmp(_JMP, 0) ;
  548.               }
  549.            ;
  550.  
  551. for_statement  :  for_front  statement
  552.               { INST *c_addr = code_ptr ;
  553.                 unsigned len = code_pop(code_ptr) ;
  554.  
  555.                 code_ptr += len ;
  556.                 patch_jmp(code_ptr) ;
  557.                 len = code_pop(code_ptr) ;
  558.                 code_ptr += len ;
  559.                 code_jmp(_JNZ, $2) ;
  560.                 BC_clear( code_ptr, c_addr) ;
  561.               }
  562.               ;
  563.  
  564. fexpr0  :  /* empty */   { $$ = code_ptr; }
  565.         |  expr   { code1(_POP) ; }
  566.         ;
  567.  
  568. fexpr1  :  /*  empty */
  569.             { /* this will be wiped out when the jmp is coded */
  570.               $$ = code_ptr ; code2(_PUSHC, &cell_one) ; }
  571.         |   expr
  572.         ;
  573.  
  574. /* arrays  */
  575.  
  576. array   :   ID
  577.             { switch($1->type)
  578.               {
  579.                 case ST_NONE :  /* a new array */
  580.                     $1->type = ST_ARRAY ;
  581.                     $1->stval.array = new_ARRAY() ;
  582.                     break ;
  583.  
  584.                 case  ST_ARRAY :
  585.                 case  ST_LOCAL_ARRAY :
  586.                     break ;
  587.  
  588.                 case  ST_LOCAL_NONE  :
  589.                     $1->type = ST_LOCAL_ARRAY ;
  590.                     active_funct->typev[$1->offset] = ST_LOCAL_ARRAY ;
  591.                     break ;
  592.  
  593.                 default : type_error($1) ; break ;
  594.               }
  595.             }
  596.         ;
  597.  
  598. expr    :  expr IN  array 
  599.            { code_array($3) ; code1(A_TEST) ; }
  600.         |  LPAREN arg2 RPAREN IN array
  601.            { $$ = $2->start ;
  602.              code1(A_CAT) ; code1($2->cnt) ;
  603.              zfree($2, sizeof(ARG2_REC)) ;
  604.  
  605.              code_array($5) ;
  606.              code1(A_TEST) ;
  607.            }
  608.         ;
  609.  
  610. lvalue  :  array mark LBOX  args  RBOX
  611.            { 
  612.              if ( $4 > 1 )
  613.              { code1(A_CAT) ; code1($4) ; }
  614.            
  615.              if( is_local($1) )
  616.              { code1(LAE_PUSHA) ; code1($1->offset) ; }
  617.              else code2(AE_PUSHA, $1->stval.array) ;
  618.              $$ = $2 ;
  619.            }
  620.         ;
  621.  
  622.  
  623. /* delete A[i] */
  624. statement :  DELETE  array mark LBOX args RBOX separator
  625.              { 
  626.                $$ = $3 ;
  627.                if ( $5 > 1 ) { code1(A_CAT) ; code1($5) ; }
  628.                code_array($2) ;
  629.                code1(A_DEL) ;
  630.              }
  631.  
  632.           ;
  633.  
  634. /*  for ( i in A )  statement */
  635.  
  636. array_loop_front :  FOR LPAREN id IN array RPAREN
  637.                     { eat_nl() ; BC_new() ;
  638.                       $$ = code_ptr ;
  639.  
  640.                       code_address($3) ;
  641.                       code_array($5) ;
  642.                       code1(A_LOOP) ; code1(_STOP) ;
  643.                       code1(0) ; /* put offset of following code here*/
  644.                     }
  645.                  ;
  646.  
  647. array_loop :  array_loop_front  statement
  648.               { code1(_STOP) ;  
  649.                 BC_clear( $2 - 2, code_ptr-1) ;
  650.                 $2[-1].op = code_ptr - & $2[-2] ;
  651.               }
  652.            ;
  653.  
  654. /*  fields   */
  655.  
  656. field   :  FIELD
  657.            { $$ = code_ptr ; code2(F_PUSHA, $1) ; }
  658.         |  DOLLAR  p_expr
  659.            { $$ = $2 ; code1( FE_PUSHA ) ; }
  660.         |  LPAREN  field  RPAREN
  661.            { $$ = $2 ; }
  662.         ;
  663.  
  664. p_expr   :  field   %prec CAT /* removes field (++|--) sr conflict */
  665.            { if ( code_ptr[-2].op == F_PUSHA )
  666.                    code_ptr[-2].op =  
  667.                        ((CELL *)code_ptr[-1].ptr == field ||
  668.                         (CELL *)code_ptr[-1].ptr >  field+NF )
  669.                         ? _PUSHI : F_PUSHI ;
  670.              else if ( code_ptr[-1].op == FE_PUSHA ) 
  671.                    code_ptr[-1].op = FE_PUSHI ;
  672.              else  bozo("missing F(E)_PUSHA") ;
  673.            }
  674.         ;
  675.  
  676. expr    :  field   ASSIGN   expr { code1(F_ASSIGN) ; }
  677.         |  field   ADD_ASG  expr { code1(F_ADD_ASG) ; }
  678.         |  field   SUB_ASG  expr { code1(F_SUB_ASG) ; }
  679.         |  field   MUL_ASG  expr { code1(F_MUL_ASG) ; }
  680.         |  field   DIV_ASG  expr { code1(F_DIV_ASG) ; }
  681.         |  field   MOD_ASG  expr { code1(F_MOD_ASG) ; }
  682.         |  field   POW_ASG  expr { code1(F_POW_ASG) ; }
  683.         ;
  684.  
  685. /* split is handled different than a builtin because
  686.    it takes an array and optionally a regular expression as args */
  687.  
  688. p_expr :  SPLIT LPAREN expr COMMA  array RPAREN
  689.              { $$ = $3 ;
  690.                code_array($5) ;
  691.                code2(_PUSHI, &fs_shadow) ;
  692.                code2(_BUILTIN, bi_split) ;
  693.              }
  694.           |  SPLIT LPAREN expr COMMA array COMMA
  695.                { code_array($5) ; }
  696.              split_back
  697.              { $$ = $3 ; code2(_BUILTIN, bi_split) ; }
  698.           ;
  699.  
  700. /* split back is not the same as
  701.    re_or_expr RPAREN
  702.    because the action is cast_for_split() instead
  703.    of cast_to_RE()
  704. */
  705.  
  706. split_back :  expr RPAREN
  707.              { 
  708.                if ( code_ptr[-2].op == _PUSHC &&
  709.                    ((CELL *)code_ptr[-1].ptr)->type == C_STRING )
  710.                    cast_for_split(code_ptr[-1].ptr) ;
  711.              }
  712.  
  713.            |  RE  RPAREN
  714.              { code2(_PUSHC, $1) ; }
  715.            ;
  716.  
  717.  
  718.              
  719.  
  720. /*  match(expr, RE) */
  721.  
  722. p_expr : MATCH_FUNC LPAREN expr COMMA re_or_expr RPAREN
  723.         { $$ = $3 ; code2(_BUILTIN, bi_match) ; }
  724.      ;
  725.  
  726. re_or_expr  :   RE
  727.                 { $$ = code_ptr ;
  728.                   code2(_PUSHC, $1) ;
  729.                 }
  730.             |   expr    %prec  MATCH
  731.                 { if ( code_ptr[-2].op == _PUSHC &&
  732.                        ((CELL *)code_ptr[-1].ptr)->type == C_STRING )
  733.                      /* re compile now */
  734.                      cast_to_RE((CELL *) code_ptr[-1].ptr) ;
  735.                 }
  736.             ;
  737.  
  738. /* length w/o an argument */
  739.  
  740. p_expr :  LENGTH
  741.           { $$ = code_ptr ;
  742.             code2(_PUSHI, field) ;
  743.             code2(_BUILTIN, bi_length) ;
  744.           }
  745.        ;
  746.  
  747. exit_statement :  EXIT   separator
  748.                     { $$ = code_ptr ;
  749.                       code1(_EXIT0) ; }
  750.                |  EXIT   expr  separator
  751.                     { $$ = $2 ; code1(_EXIT) ; }
  752.  
  753. return_statement :  RETURN   separator
  754.                     { $$ = code_ptr ;
  755.                       code1(_RET0) ; }
  756.                |  RETURN   expr  separator
  757.                     { $$ = $2 ; code1(_RET) ; }
  758.  
  759. /* getline */
  760.  
  761. p_expr :  getline      %prec  GETLINE
  762.           { $$ = code_ptr ;
  763.             code2(F_PUSHA, &field[0]) ;
  764.             code1(_PUSHINT) ; code1(0) ; 
  765.             code2(_BUILTIN, bi_getline) ;
  766.             getline_flag = 0 ;
  767.           }
  768.        |  getline  fvalue     %prec  GETLINE
  769.           { $$ = $2 ;
  770.             code1(_PUSHINT) ; code1(0) ;
  771.             code2(_BUILTIN, bi_getline) ;
  772.             getline_flag = 0 ;
  773.           }
  774.        |  getline_file  p_expr    %prec IO_IN
  775.           { code1(_PUSHINT) ; code1(F_IN) ;
  776.             code2(_BUILTIN, bi_getline) ;
  777.             /* getline_flag already off in yylex() */
  778.           }
  779.        |  p_expr PIPE GETLINE  
  780.           { code2(F_PUSHA, &field[0]) ;
  781.             code1(_PUSHINT) ; code1(PIPE_IN) ;
  782.             code2(_BUILTIN, bi_getline) ;
  783.           }
  784.        |  p_expr PIPE GETLINE   fvalue
  785.           { 
  786.             code1(_PUSHINT) ; code1(PIPE_IN) ;
  787.             code2(_BUILTIN, bi_getline) ;
  788.           }
  789.        ;
  790.  
  791. getline :   GETLINE  { getline_flag = 1 ; }
  792.  
  793. fvalue  :   lvalue  |  field  ;
  794.  
  795. getline_file  :  getline  IO_IN
  796.                  { $$ = code_ptr ;
  797.                    code2(F_PUSHA, field+0) ;
  798.                  }
  799.               |  getline fvalue IO_IN
  800.                  { $$ = $2 ; }
  801.               ;
  802.  
  803. /*==========================================
  804.     sub and gsub  
  805.   ==========================================*/
  806.  
  807. p_expr  :  sub_or_gsub LPAREN re_or_expr COMMA  expr  sub_back
  808.            {
  809.              if ( $6 - $5 == 2   &&
  810.                   $5->op == _PUSHC  &&
  811.                   ((CELL *) $5[1].ptr)->type == C_STRING )
  812.              /* cast from STRING to REPL at compile time */
  813.                  cast_to_REPL( (CELL *) $5[1].ptr ) ;
  814.  
  815.              code2(_BUILTIN, $1) ;
  816.              $$ = $3 ;
  817.            }
  818.  
  819. sub_or_gsub :  SUB  { $$ = bi_sub ; }
  820.             |  GSUB { $$ = bi_gsub ; }
  821.             ;
  822.  
  823. sub_back    :   RPAREN    /* substitute into $0  */
  824.                 { $$ = code_ptr ;
  825.                   code2(F_PUSHA, &field[0]) ; 
  826.                 }
  827.  
  828.             |   COMMA fvalue  RPAREN
  829.                 { $$ = $2 ; }
  830.             ;
  831.  
  832. /*================================================
  833.     user defined functions
  834.  *=================================*/
  835.  
  836. function_def  :  funct_start  block
  837.                  { resize_fblock($1, code_ptr) ;
  838.                    code_ptr = main_code_ptr ;
  839.                    scope = SCOPE_MAIN ;
  840.                    active_funct = (FBLOCK *) 0 ;
  841.                    restore_ids() ;
  842.                  }
  843.               ;
  844.                    
  845.  
  846. funct_start   :  funct_head  LPAREN  f_arglist  RPAREN
  847.                  { eat_nl() ;
  848.                    scope = SCOPE_FUNCT ;
  849.                    active_funct = $1 ;
  850.                    main_code_ptr = code_ptr ;
  851.  
  852.                    if ( $1->nargs = $3 )
  853.                         $1->typev = (char *) memset(
  854.                                zmalloc($3), ST_LOCAL_NONE, $3) ;
  855.                    else $1->typev = (char *) 0 ;
  856.                    code_ptr = $1->code = 
  857.                        (INST *) zmalloc(PAGE_SZ*sizeof(INST)) ;
  858.                  }
  859.               ;
  860.                   
  861. funct_head    :  FUNCTION  ID
  862.                  { FBLOCK  *fbp ;
  863.  
  864.                    if ( $2->type == ST_NONE )
  865.                    {
  866.                          $2->type = ST_FUNCT ;
  867.                          fbp = $2->stval.fbp = 
  868.                              (FBLOCK *) zmalloc(sizeof(FBLOCK)) ;
  869.                          fbp->name = $2->name ;
  870.                    }
  871.                    else
  872.                    {
  873.                          type_error( $2 ) ;
  874.  
  875.                          /* this FBLOCK will not be put in
  876.                             the symbol table */
  877.                          fbp = (FBLOCK*) zmalloc(sizeof(FBLOCK)) ;
  878.                          fbp->name = "" ;
  879.                    }
  880.                    $$ = fbp ;
  881.                  }
  882.  
  883.               |  FUNCTION  FUNCT_ID
  884.                  { $$ = $2 ; 
  885.                    if ( $2->code ) 
  886.                        compile_error("redefinition of %s" , $2->name) ;
  887.                  }
  888.               ;
  889.                          
  890. f_arglist  :  /* empty */ { $$ = 0 ; }
  891.            |  f_args
  892.            ;
  893.  
  894. f_args     :  ID
  895.               { $1 = save_id($1->name) ;
  896.                 $1->type = ST_LOCAL_NONE ;
  897.                 $1->offset = 0 ;
  898.                 $$ = 1 ;
  899.               }
  900.            |  f_args  COMMA  ID
  901.               { if ( is_local($3) ) 
  902.                   compile_error("%s is duplicated in argument list",
  903.                     $3->name) ;
  904.                 else
  905.                 { $3 = save_id($3->name) ;
  906.                   $3->type = ST_LOCAL_NONE ;
  907.                   $3->offset = $1 ;
  908.                   $$ = $1 + 1 ;
  909.                 }
  910.               }
  911.            ;
  912.  
  913. /* a call to a user defined function */
  914.              
  915. p_expr  :  FUNCT_ID mark  call_args
  916.            { $$ = $2 ;
  917.              code2(_CALL, $1) ;
  918.  
  919.              if ( $3 )  code1($3->arg_num+1) ;
  920.              else  code1(0) ;
  921.                
  922.              check_fcall($1, scope, active_funct, 
  923.                          $3, token_lineno) ;
  924.            }
  925.         ;
  926.  
  927. call_args  :   LPAREN   RPAREN
  928.                { $$ = (CA_REC *) 0 ; }
  929.            |   ca_front  ca_back
  930.                { $$ = $2 ;
  931.                  $$->link = $1 ;
  932.                  $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  933.                }
  934.            ;
  935.  
  936. /* The funny definition of ca_front with the COMMA bound to the ID is to
  937.    force a shift to avoid a reduce/reduce conflict
  938.    ID->id or ID->array
  939.  
  940.    Or to avoid a decision, if the type of the ID has not yet been
  941.    determined
  942. */
  943.  
  944. ca_front   :  LPAREN
  945.               { $$ = (CA_REC *) 0 ; }
  946.            |  ca_front  expr   COMMA
  947.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  948.                 $$->link = $1 ;
  949.                 $$->type = CA_EXPR  ;
  950.                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  951.               }
  952.            |  ca_front  ID   COMMA
  953.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  954.                 $$->link = $1 ;
  955.                 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
  956.  
  957.                 code_call_id($$, $2) ;
  958.               }
  959.            ;
  960.  
  961. ca_back    :  expr   RPAREN
  962.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  963.                 $$->type = CA_EXPR ;
  964.               }
  965.  
  966.            |  ID    RPAREN
  967.               { $$ = (CA_REC *) zmalloc(sizeof(CA_REC)) ;
  968.                 code_call_id($$, $1) ;
  969.               }
  970.            ;
  971.  
  972.  
  973.     
  974.  
  975. %%
  976.  
  977. /* resize the code for a user function */
  978.  
  979. static void  resize_fblock( fbp, code_ptr )
  980.   FBLOCK *fbp ;
  981.   INST *code_ptr ;
  982. { int size ;
  983.  
  984.   code1(_RET0) ; /* make sure there is always a return statement */
  985.  
  986.   if ( dump_code )  
  987.   { code1(_HALT) ; /*stops da() */
  988.     add_to_fdump_list(fbp) ;
  989.   }
  990.  
  991.   if ( (size = code_ptr - fbp->code) > PAGE_SZ-1 )
  992.         overflow("function code size", PAGE_SZ ) ;
  993.  
  994.   /* resize the code */
  995.   fbp->code = (INST*) zrealloc(fbp->code, PAGE_SZ*sizeof(INST),
  996.                        size * sizeof(INST) ) ;
  997.  
  998. }
  999.  
  1000. static void code_array(p)
  1001.   register SYMTAB *p ;
  1002. { if ( is_local(p) )
  1003.   { code1(LA_PUSHA) ; code1(p->offset) ; }
  1004.   else  code2(A_PUSHA, p->stval.array) ;
  1005. }
  1006.  
  1007. static  int  current_offset()
  1008. {
  1009.   switch( scope )
  1010.   { 
  1011.     case  SCOPE_MAIN :  return code_ptr - main_start ;
  1012.     case  SCOPE_BEGIN :  return code_ptr - begin_start ;
  1013.     case  SCOPE_END   :  return code_ptr - end_start ;
  1014.     case  SCOPE_FUNCT :  return code_ptr - active_funct->code ;
  1015.   }
  1016. }
  1017.  
  1018. static void  code_call_id( p, ip )
  1019.   register CA_REC *p ;
  1020.   register SYMTAB *ip ;
  1021. { static CELL dummy ;
  1022.  
  1023.   switch( ip->type )
  1024.   {
  1025.     case  ST_VAR  :
  1026.             p->type = CA_EXPR ;
  1027.             code2(_PUSHI, ip->stval.cp) ;
  1028.             break ;
  1029.  
  1030.     case  ST_LOCAL_VAR  :
  1031.             p->type = CA_EXPR ;
  1032.             code1(L_PUSHI) ;
  1033.             code1(ip->offset) ;
  1034.             break ;
  1035.  
  1036.     case  ST_ARRAY  :
  1037.             p->type = CA_ARRAY ;
  1038.             code2(A_PUSHA, ip->stval.array) ;
  1039.             break ;
  1040.  
  1041.     case  ST_LOCAL_ARRAY :
  1042.             p->type = CA_ARRAY ;
  1043.             code1(LA_PUSHA) ;
  1044.             code1(ip->offset) ;
  1045.             break ;
  1046.  
  1047.     case  ST_NONE :
  1048.             p->type = ST_NONE ;
  1049.             p->call_offset = current_offset() ;
  1050.             p->sym_p = ip ;
  1051.             code2(_PUSHI, &dummy) ;
  1052.             break ;
  1053.  
  1054.     case  ST_LOCAL_NONE :
  1055.             p->type = ST_LOCAL_NONE ;
  1056.             p->call_offset = current_offset() ;
  1057.             p->type_p = & active_funct->typev[ip->offset] ;
  1058.             code1(L_PUSHI) ; 
  1059.             code1(ip->offset) ;
  1060.             break ;
  1061.  
  1062.   
  1063. #ifdef   DEBUG
  1064.     default :
  1065.             bozo("code_call_id") ;
  1066. #endif
  1067.  
  1068.   }
  1069. }
  1070.  
  1071. int parse()
  1072. { int yy = yyparse() ;
  1073.   if ( resolve_list )  resolve_fcalls() ;
  1074.   return yy ;
  1075. }
  1076.  
  1077.